Syntax10.Scn.Fnt
Syntax10i.Scn.Fnt
StampElems
Alloc
3 Mar 96
FoldElems
Syntax10.Scn.Fnt
TCP, 
Syntax10.Scn.Fnt
(*V24*)
Syntax10.Scn.Fnt
NetSystem, 
Syntax10b.Scn.Fnt
Syntax10.Scn.Fnt
		TCPConnection = POINTER TO RECORD(TCP.ConnectionDesc) channel: Channel END;
		TCPChannel = POINTER TO RECORD(ChannelDesc) connection: TCPConnection END;
		TCPTask = POINTER TO RECORD(TaskDesc) id: LONGINT END;
		TCPListener = POINTER TO RECORD(ListenerDesc) l: TCP.Listener END;
Syntax10.Scn.Fnt
		NSConnection = POINTER TO RECORD(NetSystem.StreamDesc) channel: Channel END;
		NSChannel = POINTER TO RECORD(ChannelDesc) connection: NSConnection END;
		NSTask = POINTER TO RECORD(TaskDesc) c: NSConnection END;
		NSListener = POINTER TO RECORD(ListenerDesc) l: NetSystem.Connection END;
Syntax10.Scn.Fnt
(*V24*)
Syntax10.Scn.Fnt
	PROCEDURE TCPGetState(c: Channel; VAR available: LONGINT; VAR terminated: BOOLEAN);
		VAR connection: TCP.Connection;
	BEGIN connection := c(TCPChannel).connection;
		available := TCP.Available(connection); terminated := (available = 0) & ~TCP.Connected(connection)
	END TCPGetState;
	PROCEDURE TCPReadBytes(c: Channel; VAR bytes: ARRAY OF CHAR; n: LONGINT);
	BEGIN TCP.ReadBytes(c(TCPChannel).connection, bytes, 0, n)
	END TCPReadBytes;
	PROCEDURE TCPSendBytes(c: Channel; VAR bytes: ARRAY OF CHAR; n: LONGINT);
		VAR connection: TCP.Connection;
	BEGIN connection := c(TCPChannel).connection;
		IF TCP.Connected(connection) THEN TCP.WriteBytes(connection, bytes, 0, n) END
	END TCPSendBytes;
	PROCEDURE TCPSendBreak(c: Channel);
	END TCPSendBreak;
	PROCEDURE TCPClose(c: Channel);
		VAR connection: TCP.Connection;
	BEGIN connection := c(TCPChannel).connection;
		IF TCP.Connected(connection) THEN TCP.Disconnect(connection) END
	END TCPClose;
	PROCEDURE TCPSelfChannel(t: Task): Channel;
		VAR channel: Channel; c: TCP.Connection;
	BEGIN c := TCP.ThisConnection(t(TCPTask).id);
		IF c # NIL THEN channel := c(TCPConnection).channel ELSE channel := NIL END;
		RETURN channel
	END TCPSelfChannel;
	PROCEDURE TCPSetupChannel(connection: TCPConnection; VAR channel: Channel; VAR task: Task);
		VAR c: TCPChannel; t: TCPTask;
	BEGIN NEW(c); c.connection := connection; connection.channel := c;
		c.getState := TCPGetState; c.readBytes := TCPReadBytes;
		c.sendBytes := TCPSendBytes; c.sendBreak := TCPSendBreak; c.close := TCPClose;
		NEW(t); t.id := connection.id; t.channel := TCPSelfChannel;
		channel := c; task := t
	END TCPSetupChannel;
	PROCEDURE TCPNewSession(hostname: ARRAY OF CHAR; port: LONGINT): Session;
		VAR res: INTEGER; c: TCPConnection; channel: Channel; t: Task; s: Session; adr: TCP.IpAdr;
	BEGIN s := NIL; TCP.HostByName(hostname, adr, res);
		IF res = TCP.Done THEN NEW(c); TCP.Connect(c, TCP.AnyPort, adr, SHORT(port), 0, res);
			IF res = TCP.Done THEN TCPSetupChannel(c, channel, t); s := NewSession(channel, t, hostname) END
		END;
		RETURN s
	END TCPNewSession;
	PROCEDURE TCPRequested(l: Listener): BOOLEAN;
	BEGIN RETURN TCP.Requested(l(TCPListener).l)
	END TCPRequested;
	PROCEDURE TCPAcceptedSession(l: Listener; VAR serverName: ARRAY OF CHAR): Session;
		VAR res: INTEGER; c: TCPConnection; channel: Channel; t: Task; s: Session;
	BEGIN s := NIL;
		NEW(c); TCP.Accept(l(TCPListener).l, c, res);
		IF res = TCP.Done THEN TCPSetupChannel(c, channel, t); s := NewSession(channel, t, serverName) END;
		RETURN s
	END TCPAcceptedSession;
	PROCEDURE TCPRemove(l: Listener);
	BEGIN TCP.Close(l(TCPListener).l)
	END TCPRemove;
	PROCEDURE TCPNewListener(port: LONGINT): TCPListener;
		VAR res: INTEGER; listener: TCPListener; l: TCP.Listener;
	BEGIN listener := NIL;
		NEW(l); TCP.Listen(l, SHORT(port), TCP.AnyAdr, TCP.AnyPort, res);
		IF res = TCP.Done THEN NEW(listener); listener.l := l;
			listener.requested := TCPRequested; listener.acceptedSession := TCPAcceptedSession;
			listener.remove := TCPRemove
		END;
		RETURN listener
	END TCPNewListener;
Syntax10.Scn.Fnt
(*V24*)
Syntax10.Scn.Fnt
	PROCEDURE NSGetState(c: Channel; VAR available: LONGINT; VAR terminated: BOOLEAN);
		VAR connection: NetSystem.Stream;
	BEGIN connection := c(NSChannel).connection;
		available := NetSystem.Available(connection);
		terminated := (available = 0) & (connection.C.state = NetSystem.closed)
	END NSGetState;
	PROCEDURE NSReadBytes(c: Channel; VAR bytes: ARRAY OF CHAR; n: LONGINT);
	BEGIN NetSystem.ReadBytes(c(NSChannel).connection, bytes, 0, n)
	END NSReadBytes;
	PROCEDURE NSSendBytes(c: Channel; VAR bytes: ARRAY OF CHAR; n: LONGINT);
		VAR connection: NetSystem.Stream;
	BEGIN connection := c(NSChannel).connection;
		IF connection.C.state # NetSystem.closed THEN NetSystem.WriteBytes(connection, bytes, 0, n) END
	END NSSendBytes;
	PROCEDURE NSSendBreak(c: Channel);
	END NSSendBreak;
	PROCEDURE NSClose(c: Channel);
		VAR connection: NetSystem.Stream;
	BEGIN connection := c(NSChannel).connection;
		IF connection.C.state # NetSystem.closed THEN NetSystem.CloseConnection(connection.C) END
	END NSClose;
	PROCEDURE NSSelfChannel(t: Task): Channel;
	BEGIN RETURN t(NSTask).c.channel
	END NSSelfChannel;
	PROCEDURE NSSetupChannel(connection: NSConnection; VAR channel: Channel; VAR task: Task);
		VAR c: NSChannel; t: NSTask;
	BEGIN NEW(c); c.connection := connection; connection.channel := c;
		c.getState := NSGetState; c.readBytes := NSReadBytes;
		c.sendBytes := NSSendBytes; c.sendBreak := NSSendBreak; c.close := NSClose;
		NEW(t); t.c := connection; t.channel := NSSelfChannel;
		channel := c; task := t
	END NSSetupChannel;
	PROCEDURE NSNewSession(hostname: ARRAY OF CHAR; port: LONGINT): Session;
		VAR res: INTEGER; connection: NSConnection; channel: Channel; t: Task; s: Session; c: NetSystem.Connection;
	BEGIN s := NIL;
		NEW(c); NetSystem.OpenConnection(NetSystem.anyport, SHORT(port), hostname, NetSystem.tcp, c, res);
		IF res = NetSystem.done THEN
			NEW(connection); NetSystem.OpenStream(connection, c);
			NSSetupChannel(connection, channel, t); s := NewSession(channel, t, hostname)
		END;
		RETURN s
	END NSNewSession;
	PROCEDURE NSRequested(l: Listener): BOOLEAN;
	BEGIN RETURN NetSystem.Requested(l(NSListener).l)
	END NSRequested;
	PROCEDURE NSAcceptedSession(l: Listener; VAR serverName: ARRAY OF CHAR): Session;
		VAR res: INTEGER; c: NSConnection; channel: Channel; t: Task; s: Session; connection: NetSystem.Connection;
	BEGIN s := NIL;
		NEW(c); NetSystem.Accept(l(NSListener).l, connection, res);
		IF res = NetSystem.done THEN
			NetSystem.OpenStream(c, connection);
			NSSetupChannel(c, channel, t); s := NewSession(channel, t, serverName) END;
		RETURN s
	END NSAcceptedSession;
	PROCEDURE NSRemove(l: Listener);
	BEGIN NetSystem.CloseConnection(l(NSListener).l)
	END NSRemove;
	PROCEDURE NSNewListener(port: LONGINT): NSListener;
		VAR res: INTEGER; listener: NSListener; l: NetSystem.Connection;
	BEGIN listener := NIL;
		NEW(l);
		NetSystem.OpenConnection(SHORT(port), NetSystem.anyport, NetSystem.anyIP, NetSystem.tcp, l, res);
		IF res = NetSystem.done THEN NEW(listener); listener.l := l;
			listener.requested := NSRequested; listener.acceptedSession := NSAcceptedSession;
			listener.remove := NSRemove
		END;
		RETURN listener
	END NSNewListener;
Syntax10.Scn.Fnt
(*V24*)
Syntax10.Scn.Fnt
s := TCPNewSession(hostname, port)
Syntax10.Scn.Fnt
s := NSNewSession(hostname, port)
Syntax10.Scn.Fnt
l := TCPNewListener(port);
				IF l # NIL THEN ok := TRUE; s.listener := l; s.notify := c END
Syntax10.Scn.Fnt
l := NSNewListener(port);
				IF l # NIL THEN ok := TRUE; s.listener := l; s.notify := c END
Syntax10.Scn.Fnt
(*V24*)
MODULE Sessions; (* ww 
	IMPORT
(*TCP*)
V24, 
(*NetSystem*)
Oberon, Texts, Viewers, Display;
	CONST
		Sec* = 300;
	TYPE
		Channel = POINTER TO ChannelDesc;
		Terminal* = POINTER TO TerminalDesc;
		Session* = POINTER TO SessionDesc;
		SessionDesc = RECORD
			name: ARRAY 64 OF CHAR;
			terminals, p: Terminal;
			nomoreneeded: BOOLEAN;
			channel: Channel
		END;
		ChannelDesc = RECORD
			getState: PROCEDURE (c: Channel; VAR available: LONGINT; VAR terminated: BOOLEAN);
			readBytes: PROCEDURE (c: Channel; VAR bytes: ARRAY OF CHAR; n: LONGINT);
			sendBytes: PROCEDURE (c: Channel; VAR bytes: ARRAY OF CHAR; n: LONGINT);
			sendBreak: PROCEDURE (c: Channel);
			close: PROCEDURE (c: Channel);
			session: Session
		END;
		Task = POINTER TO TaskDesc;
		TaskDesc = RECORD(Oberon.TaskDesc)
			channel: PROCEDURE (self: Task): Channel
		END;
		Receiver* = PROCEDURE (t: Terminal; ch: CHAR);
		Flusher* = PROCEDURE (t: Terminal; changed, terminated: BOOLEAN);
		TerminalDesc* = RECORD
			next: Terminal;
			session: Session;
			nextTime, timeout*: LONGINT;
			receive*: Receiver;
			flush*: Flusher;
			safe*: BOOLEAN
		END;
		Sentinel = POINTER TO RECORD(TerminalDesc) END;
		Tester* = PROCEDURE (t: Terminal): BOOLEAN;
		IdentifyMsg* = RECORD(Display.FrameMsg) session*: Session END;
		Listener = POINTER TO ListenerDesc;
		Service* = POINTER TO ServiceDesc;
		ServiceCall* = PROCEDURE (this: Service; s: Session);
		ServiceDesc* = RECORD
			name: ARRAY 64 OF CHAR;
			notify: ServiceCall;
			listener: Listener
		END;
		ListenerDesc = RECORD
			requested: PROCEDURE (l: Listener): BOOLEAN;
			acceptedSession: PROCEDURE (l: Listener; VAR serverName: ARRAY OF CHAR): Session;
			remove: PROCEDURE (l: Listener)
		END;
		ServiceTask = POINTER TO RECORD(Oberon.TaskDesc) service: Service END;
(*TCP*)
(*NetSystem*)
		v24Session: Session;
	PROCEDURE Distribute(s: Session; ch: CHAR);
		VAR t: Terminal;
	BEGIN s.p := s.terminals; t := s.p.next;
		WHILE ~(t IS Sentinel) DO
			IF ~t.safe THEN s.p.next := t.next; t.next := NIL END;
			t.receive(t, ch);
			IF (t.session = s) & (t.next = NIL) THEN t.next := s.p.next; s.p.next := t; s.p := t
			ELSIF s.p.next = t THEN s.p := t
			END;
			t := s.p.next
		END
	END Distribute;
	PROCEDURE Flush(s: Session; changed, terminated: BOOLEAN);
		VAR t: Terminal; now: LONGINT;
	BEGIN now := Oberon.Time(); s.p := s.terminals; t := s.p.next;
		WHILE ~(t IS Sentinel) DO
			IF changed OR terminated OR (t.nextTime <= now) & (t.timeout >= 0) THEN
				IF ~t.safe THEN s.p.next := t.next; t.next := NIL END;
				t.flush(t, changed, terminated); t.nextTime := now + t.timeout;
				IF (t.session = s) & (t.next = NIL) THEN t.next := s.p.next; s.p.next := t; s.p := t
				ELSIF s.p.next = t THEN s.p := t
				END
			ELSE s.p := t
			END;
			t := s.p.next
		END
	END Flush;
	PROCEDURE Close*(s: Session);
		VAR c: Channel;
	BEGIN c := s.channel;
		IF c.close # NIL THEN c.close(c) END
	END Close;
	PROCEDURE TaskHandler;
		CONST BufSize = 4096;
		VAR n, i: LONGINT; terminated: BOOLEAN; s: Session; c: Channel; self: Task; buf: ARRAY BufSize OF CHAR;
	BEGIN self := Oberon.CurTask(Task); c := self.channel(self);
		IF c # NIL THEN s := c.session; c.getState(c, n, terminated);
			IF n # 0 THEN
				IF n > BufSize THEN n := BufSize END;
				c.readBytes(c, buf, n);
				i := 0;
				REPEAT Distribute(s, buf[i]); INC(i) UNTIL i = n
			END;
			Flush(s, n # 0, terminated);
			IF terminated THEN Close(s); Oberon.Remove(Oberon.CurTask) END
		ELSE Oberon.Remove(Oberon.CurTask)
		END
	END TaskHandler;
	PROCEDURE NewSession(c: Channel; task: Task; VAR name: ARRAY OF CHAR): Session;
		VAR s: Session; sentinel: Sentinel;
	BEGIN NEW(s); COPY(name, s.name);
		s.channel := c; c.session := s;
		NEW(sentinel); s.terminals := sentinel; sentinel.session := s; sentinel.next := sentinel;
		task.handle := TaskHandler; task.safe := TRUE; task.time := -1;
		Oberon.Install(task);
		RETURN s
	END NewSession;
	PROCEDURE Install*(t: Terminal; s: Session; r: Receiver; f: Flusher; timeout: LONGINT);
		VAR sentinel: Terminal;
	BEGIN ASSERT(t.session = NIL);
		t.session := s; sentinel := s.terminals; t.next := sentinel.next; sentinel.next := t;
		IF s.p = s.terminals THEN s.p := t END;
		t.receive := r; t.flush := f; t.timeout := timeout; t.nextTime := Oberon.Time() + timeout
	END Install;
	PROCEDURE Remove*(t: Terminal);
		VAR p, q: Terminal; s: Session;
	BEGIN s := t.session;
		IF s # NIL THEN p := s.terminals; q := p.next;
			WHILE (q # t) & ~(q IS Sentinel) DO p := q; q := q.next END;
			IF q = t THEN p.next := t.next;
				IF q = s.p THEN s.p := p END
			END;
			t.session := NIL; t.next := NIL;
			p := s.terminals;
			IF p.next = p THEN Close(s) END
		END
	END Remove;
	PROCEDURE ThisSession*(t: Terminal): Session;
	BEGIN RETURN t.session
	END ThisSession;
	PROCEDURE ThisTerminal*(s: Session; test: Tester): Terminal;
		VAR t: Terminal;
	BEGIN t := s.terminals.next;
		WHILE ~(t IS Sentinel) & ~test(t) DO t := t.next END;
		IF t IS Sentinel THEN RETURN NIL ELSE RETURN t END
	END ThisTerminal;
	PROCEDURE GetName*(s: Session; VAR name: ARRAY OF CHAR);
	BEGIN COPY(s.name, name)
	END GetName;
	PROCEDURE SendChar*(s: Session; ch: CHAR);
		VAR c: Channel; buf: ARRAY 1 OF CHAR;
	BEGIN c := s.channel; buf[0] := ch; c.sendBytes(c, buf, 1)
	END SendChar;
	PROCEDURE SendBytes*(s: Session; VAR bytes: ARRAY OF CHAR; n: LONGINT);
		VAR c: Channel;
	BEGIN c := s.channel; c.sendBytes(c, bytes, n)
	END SendBytes;
	PROCEDURE SendString*(s: Session; str: ARRAY OF CHAR);
		VAR i: LONGINT; c: Channel;
	BEGIN i := 0;
		WHILE str[i] # 0X DO INC(i) END;
		c := s.channel; c.sendBytes(c, str, i)
	END SendString;
	PROCEDURE SendBreak*(s: Session);
		VAR c: Channel;
	BEGIN c := s.channel; c.sendBreak(c)
	END SendBreak;
(*TCP*)
	PROCEDURE V24GetState(c: Channel; VAR available: LONGINT; VAR terminated: BOOLEAN);
	BEGIN available := V24.Available(); terminated := FALSE
	END V24GetState;
	PROCEDURE V24ReadBytes(c: Channel; VAR bytes: ARRAY OF CHAR; n: LONGINT);
		VAR i: LONGINT;
	BEGIN i := 0;
		WHILE i # n DO V24.Receive(bytes[i]); INC(i) END
	END V24ReadBytes;
	PROCEDURE V24SendBytes(c: Channel; VAR bytes: ARRAY OF CHAR; n: LONGINT);
		VAR i: LONGINT;
	BEGIN i := 0;
		WHILE i # n DO V24.Send(bytes[i]); INC(i) END
	END V24SendBytes;
	PROCEDURE V24SendBreak(c: Channel);
	BEGIN V24.Break
	END V24SendBreak;
	PROCEDURE V24SelfChannel(self: Task): Channel;
	BEGIN RETURN v24Session.channel
	END V24SelfChannel;
	PROCEDURE V24NewSession(): Session;
		VAR c: Channel; task: Task; name: ARRAY 4 OF CHAR;
	BEGIN NEW(c); c.getState := V24GetState; c.readBytes := V24ReadBytes;
		c.sendBytes := V24SendBytes; c.sendBreak := V24SendBreak;
		NEW(task); task.channel := V24SelfChannel;
		name := "V24"; RETURN NewSession(c, task, name)
	END V24NewSession;
(*NetSystem*)
	PROCEDURE New*(hostname: ARRAY OF CHAR; port: LONGINT): Session;
		VAR s: Session;
	BEGIN s := NIL;
		IF hostname = "V24" THEN 
s := v24Session
		ELSE 
(*TCP*)
(*NetSystem*)
		END;
		RETURN s
	END New;
	PROCEDURE ServiceTaskHandler;
		VAR serv: Service; l: Listener; s: Session;
	BEGIN serv := Oberon.CurTask(ServiceTask).service; l := serv.listener;
		IF l # NIL THEN
			IF l.requested(l) THEN s := l.acceptedSession(l, serv.name);
				IF s # NIL THEN serv.notify(serv, s) END
			END
		ELSE Oberon.Remove(Oberon.CurTask)
		END
	END ServiceTaskHandler;
	PROCEDURE InstallService*(s: Service; port: LONGINT; c: ServiceCall; name: ARRAY OF CHAR; VAR ok: BOOLEAN);
		VAR l: Listener; task: ServiceTask;
	BEGIN ok := FALSE;
		IF s.listener = NIL THEN
			IF name = "V24" THEN
			ELSE 
(*TCP*)
(*NetSystem*)
			END
		END;
		IF ok THEN NEW(task); task.handle := ServiceTaskHandler; task.time := -1; task.service := s;
			Oberon.Install(task); COPY(name, s.name)
		END
	END InstallService;
	PROCEDURE RemoveService*(s: Service);
		VAR l: Listener;
	BEGIN l := s.listener; l.remove(l); s.listener := NIL
	END RemoveService;
	PROCEDURE Send*;
		VAR text: Texts.Text; beg, end, time: LONGINT; v: Viewers.Viewer; s: Texts.Scanner; identify: IdentifyMsg;
	BEGIN
		IF Oberon.Par.vwr.dsc = Oberon.Par.frame THEN v := Oberon.Par.vwr ELSE v := Oberon.FocusViewer END;
		identify.session := NIL; v.handle(v, identify);
		IF identify.session # NIL THEN
			Texts.OpenScanner(s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(s);
			IF (s.class = Texts.Char) & (s.line = 0) & (s.c = "^") THEN Oberon.GetSelection(text, beg, end, time);
				IF time > 0 THEN Texts.OpenScanner(s, text, beg); Texts.Scan(s) END
			END;
			LOOP
				IF (s.class = Texts.Name) & (s.s = "BRK") THEN SendBreak(identify.session)
				ELSIF (s.class = Texts.Name) OR (s.class = Texts.String) THEN SendString(identify.session, s.s)
				ELSIF s.class = Texts.Int THEN SendChar(identify.session, CHR(s.i MOD 256))
				ELSE EXIT
				END;
				Texts.Scan(s)
			END
		END
	END Send;
BEGIN 
v24Session := V24NewSession()
END Sessions.